(load "gui-animation.scm")

;; ------------------------------------------------------------
;; The ball ADT 
;; ------------------------------------------------------------

(define-struct ball (x y size dx dy))
;; Note: define-struct creates a structure with constructors, selectors, 
;;       modifiers and a recognizer. So for the construction above the 
;;       following procedures are defined: 
;;            make-ball
;;            ball-x
;;            ball-y
;;            ball-size
;;            ball-dx
;;            ball-dy
;;            set-ball-x!
;;            set-ball-y!
;;            set-ball-size!
;;            set-ball-dx!
;;            set-ball-dy!
;;            ball?

;; We define to additional "selectors" that will be convenient later.
(define (ball-right-x ball)
  (+ (ball-x ball) (ball-size ball)))

(define (ball-bottom-y ball)
  (+ (ball-y ball) (ball-size ball)))

;; Updates the position of the ball according to its speed vector.
(define (move-ball ball)
  (set-ball-x! ball (+ (ball-x ball) (ball-dx ball)))
  (set-ball-y! ball (+ (ball-y ball) (ball-dy ball))))

;; Handles ball/edge collisions.
(define (handle-edge-collisions ball width height)
  (when (or (< (ball-x ball) 0)
            (> (ball-right-x ball) width))
    (set-ball-dx! ball (- (ball-dx ball))))
  
  (when (or (< (ball-y ball) 0)
            (> (ball-bottom-y ball) height))
    (set-ball-dy! ball (- (ball-dy ball)))))

;; The ball itself. 
(define *the-ball* (make-ball 50 50 20 3 1))

;; Moves the ball then checks for collisions with the edges.
(define (update)
  (move-ball *the-ball*)
  (handle-edge-collisions *the-ball* 
                          (send (get-canvas *gui*) get-width)
                          (send (get-canvas *gui*) get-height)))

;; The procedures that draws the ball.
(define (draw)
  (clear)
  (draw-circle (ball-x *the-ball*) (ball-y *the-ball*) 
        (ball-size *the-ball*) (ball-size *the-ball*) *ball-pen* *ball-brush*)
  (show))

(define *ball-brush* 
  (send the-brush-list find-or-create-brush "red" 'solid))
(define *ball-pen* 
  (send the-pen-list find-or-create-pen "blue" 2 'solid))

;; Handle keys pressd; space, +, -
(define (handle-key-event key)
    (cond
      ((eq? #\+ key) 
       (set-ball-dx! *the-ball* 
                     (if (< (ball-dx *the-ball*) 0) 
                         (- (ball-dx *the-ball*) 1) 
                         (+ (ball-dx *the-ball*) 1)))
      (set-ball-dy! *the-ball* 
                     (if (< (ball-dy *the-ball*) 0) 
                         (- (ball-dy *the-ball*) 1) 
                         (+ (ball-dy *the-ball*) 1))))
      ((eq? #\- key)
       (set-ball-dx! *the-ball* 
                     (if (> (ball-dx *the-ball*) 0) 
                         (- (ball-dx *the-ball*) 1)
                         0))
       (set-ball-dy! *the-ball* 
                     (if (> (ball-dy *the-ball*) 0) 
                         (- (ball-dy *the-ball*) 1)
                         0)))
      ((eq? #\space key)
       (if *should-run*
           (stop-loop)
           (start-loop)))))

;; Starts the animation loop
(start-loop)